perm filename PS.SAI[PIC,HE] blob
sn#419572 filedate 1979-02-22 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 entry ps
C00005 00003 external string picture
C00009 00004 simple boolean procedure nopred
C00015 00005 simple procedure prepareps(integer dd, buf)
C00020 00006 procedure ssgdisplay(integer dr, dc)
C00027 00007 procedure getleaders(reference integer ct)
C00029 00008
C00034 00009 simple boolean procedure halfgaps(integer angle)
C00036 00010 internal simple procedure psmaker
C00041 00011 internal procedure findcorners
C00055 00012 IFCR NOT SMALL THENC
C00064 00013 internal simple procedure globinit
C00070 ENDMK
C⊗;
entry ps;
begin "ps"
comment
programmed by k ramesh babu
This set of procedures constitute the *.p and *.s data
structure.
APRIL 23, 1978
In one of the files -- *.p -- information about the
predecessor of the corresponding edge element is stored.
In the other, the successor info is stored.;
comment
January 12, 1979: Additional processing of .thr data for
bridging one-element gaps implemented.;
require "define.sai" source!file;
require "grafix.dcl" source!file;
require "picbuf.dcl" source!file;
require "direct.dcl" source!file;
comment
For descriptions of the above files, see <babu>*.info ;
require "seg.dcl" source!file;
require "sseg.dcl" source!file;
external string picture;
internal integer rowsz, colsz;
internal boolean cdisplay;
integer zf, zr1, zc1; real zml;
integer segno, ssegno; ! Keep count of segs and ssegs generated;
define
SGDSPDEBUG = "false",
FNDCDEBUG = "false",
SSDEBUG = "false",
SDEBUG = "FALSE",
RANGEDEBUG = "false",
SMALL = "false",
PREDICATEDEBUG = "FALSE",
MYNAME = "babu";
define heading = <print(" program of Mar 18 1978 ",crlf)>;
define fivebits = "5",
deadend = "0",
datalevel = "8", dataconst = "1",
forklevel = "16", forkconst = "2",
corner = "24", cornrconst = "3",
marked = "1";
integer array header[0:127];
define foundcorners = "header[32]",
gapsbridged = "header[33]",
noofbridges = "header[34]",
wsz = "header[35]",
iepsilon = "header[36]",
hgcount = "header[37]"; ! No of half-gaps;
integer array r, c[1:3]; ! the 3 8-neighbours for connecctivity;
integer array ltmag, ltr, ltc [1:7];
! the 7 leading terminals at a gap;
integer pagesincore; ! No of pages in
measurement purposes;
integer dirbuf, thrbuf, pbuf, sbuf, markbuf;
integer datap, datas, pptr, sptr, prer, prec, datam, mptr;
string s;
integer rscan, cscan, nr, nc;
integer dir, oppdir;
INTEGER RDEBUG, CDEBUG;
boolean branch;
comment
The booleans nopred, ssgstop denote
predicates suggested by the names -- sg for linear
segment, ssg for supersegment. These are functions of
edge element present at a pixel, its predecessor, and
successor. I have made logical simplification of the
boolean expressions, so you will have to do some fig-
uring to verify if indeed they are correct.;
comment (about initialisation routines)
There are a host of initialisation routines which got
evolved as I progressed in programming. Use an
appropriate one. Also, some initialisation routine
must be used as, otherwise, endless misery... follows.;
simple boolean procedure nopred;
comment: Denotes whether any predecessors exist for a
particular edge element. datap and datas are globals;
begin
if datap = deadend and datas neq deadend
then return(true)
else return(false);
end; "nopred"
simple boolean procedure endless;
begin
! DEFINES WHETHER THE EDGE ELEMENT WHOSE PRED AND SUCC ARE
GIVEN BY DATAP AND DATAS IS PART OF AN ENDLESS CHAIN.;
if datap div 8 = dataconst and
datas div 8 = dataconst then return(true)
else return(false);
end; "endless"
simple procedure getbranch(reference boolean ok);
begin
integer i, temp;
comment this will get the coordinates of the fork segment
at a fork, by sweeping an almost 180 deg arc about the
direction of flow of curve.;
temp := (datap+1) mod 8; i := 0; ok := false;
do begin
i := i + 1; temp := (temp + 1) mod 8;
nr := rscan; nc := cscan;
nextcoord(temp,nr,nc);
if getpnt(nr,nc,pbuf) mod 8 = (temp+4) mod 8 THEN
if temp mod 8 neq datas mod 8 then
ok := true;
end until i = 5 or ok;
end; "getbranch"
simple procedure getneighbours(integer d);
begin
comment
This procedure deposits coordinates of the neighbours of
(rscan,cscan) in (r[1:3],c[1:3]). Neighbours are computed
based on the direction of flow, d. Obbserve that they are
in counter-clockwise order;
integer i;
d := (d + 6) mod 8;
for i := 1 step 1 until 3 do
begin
d := (d+1) mod 8;
r[i] := rscan; c[i] := cscan;
nextcoord(d,r[i],c[i]);
eND;
end; "getneighbours"
simple boolean procedure npred(integer rrr, ccc);
begin "npred"
comment
Indicates whether the flow of the curve has been along a
PRIMARY PREDecessor.;
nextcoord(datap mod 8,rrr,ccc);
if rrr = prer and ccc = prec then return(true)
else return(false);
end "npred" ;
boolean procedure ssgstop(integer thisr, thisc);
begin
comment: Definition of when to stop following the contour of
a supersegment;
simple boolean procedure primarypred;
begin
comment
Indicates whether the flow of the curve has been along a
PRIMARY PREDecessor.;
nextcoord(datap mod 8,thisr,thisc);
if thisr = prer and thisc = prec then return(true)
else return(false);
end; "primarypred"
IFC PREDICATEDEBUG THENC
PRINT(" PREDICATE DEBUG",CRLF);
PPRINT(DATAS); PPRINT(DATAP); PPRINT(PRER);
PPRINT(PREC); PPRINT(THISR); PPRINT(THISC);
S := INTTY;
ENDC
if getpnt(thisr,thisc,markbuf) = marked or
datas = deadend or
(datap div 8 = forkconst and not primarypred)
then return(true)
else return(false);
end; "ssgstop"
boolean procedure sgstop(integer r, c);
return(ssgstop(r,c) or datas div 8 = forkconst or
DATAP DIV 8 = FORKCONST OR
datas div 8 = cornrconst);
simple procedure prepareps(integer dd, buf);
begin
comment
This procedure evaluates if a predecessor(successor)
exists in the specified direction and deposits the
corresponding info in the appropriate file(buf).
For details, see write-up;
integer data;
integer mag1, mag2, mag3, dir1, dir2, dir3;
dir1 := getpnt(r[1],c[1],dirbuf); data := deadend;
dir2 := getpnt(r[2],c[2],dirbuf);
dir3 := getpnt(r[3],c[3],dirbuf);
mag1 := 0; mag3 := 0; mag2 := 0;
if samedir(dir1,dir,1) then mag1 := getpnt(r[1],c[1],thrbuf);
if samedir(dir2,dir,1) then mag2 := getpnt(r[2],c[2],thrbuf);
if samedir(dir3,dir,1) then mag3 := getpnt(r[3],c[3],thrbuf);
if even(dd) then
begin "45 deg edges"
if maG1 neq 0 then
beGIN
data := ((dd + 7) mod 8 + datalevel);
IF maG3 > maG1 THeN data := ((dd+1) mod 8) +forklevel else
IF maG3 NeQ 0 THeN DaTa := ((DD + 7) mOD 8) + FOrkLeVeL;
eND eLSe
if maG3 neq 0 then data := ((dd+1) mod 8) + datalevel else
if maG2 neq 0 then data := dd + datalevel;
end else
begin "hor or vert edges"
if mag2 neq 0 then
begin
if mag3 neq 0 or mag1 neq 0 then
begin
if mag3 neq 0 and mag1 neq 0 then
data := dd + forklevel else
if mag1 neq 0 then
begin
if dir1 = dir2 then data := dd + datalevel
else data := dd + forklevel;
end else
begin
if dir3 = dir2 then data := dd + datalevel
else data := dd + forklevel;
end;
end else data := dd + datalevel;
end else
if maG1 neq 0 then
beGIN
data := ((dd + 7) mod 8) + datalevel;
if mag3 > mag1 then
begin
data := ((dd + 1) mod 8) + forklevel;
end else
if mag3 neq 0 then data := ((dd + 7) mod 8) + forklevel;
end else
if maG3 neq 0 then
begin
data := ((dd + 1) mod 8) + datalevel;
end;
end;
putpnt(rscan,cscan,data,buf);
end; "prepareps"
procedure ssgdisplay(integer dr, dc);
begin
boolean in;
integer ddr, ddc;
comment
Displays a supersegment following its contour;
IN := RCOK(DR,DC);
movecursor(dr,dc);
ddr := dr; ddc := dc;
if not cdisplay then
while not ssgstop(dr,dc) do
begin
putpnt(dr,dc,marked,markbuf); prer := dr; prec := dc;
nextcoord(datas mod 8,dr,dc);
if rcok(dr,dc) then
begin
if in then drawa(1.0*dc,-1.0*dr)
else movea(1.0*dc,-1.0*dr);
in := true;
end else in := false;
datas := getpnt(dr,dc,sbuf); datap := getpnt(dr,dc,pbuf);
end
else
while not ssgstop(dr,dc) do
begin
do begin
putpnt(dr,dc,marked,markbuf); prer := dr; prec := dc;
nextcoord(datas mod 8,dr,dc);
datas := getpnt(dr,dc,sbuf); datap := getpnt(dr,dc,pbuf);
end until sgstop(dr,dc);
clipdsp(ddr,ddc,dr,dc); ddr := dr; ddc := dc;
end;
end; "ssgdisplay"
simple procedure setps(integer r, c);
begin
! This procedure is to recapture the pointer values that
may have been obliterated due to random access;
pptr := inptr(r,c,pbuf); sptr := inptr(r,c,sbuf);
end;
internal simple procedure display;
begin
INTEGER RBEG, CBEG, REND, CEND; ! WINDOW DEFINITION;
boolean yes;
clipinit(rowsz,colsz);
do begin
begindisplay;
getbuf(rowsz,colsz,onebit,markbuf:=fndbuf);
GETWINDOW(RBEG,CBEG,REND,CEND);
for rscan := 1 step 1 until rowsz do
begin
pptr := inptr(rscan,1,pbuf); sptr := inptr(rscan,1,sbuf);
for cscan := 1 step 1 until colsz do
begin
datap := ildb(pptr); datas := ildb(sptr);
if nopred and datas neq 0 then
begin
ssgdisplay(rscan,cscan);
setps(rscan,cscan+1);
end;
end;
end;
for rscan := 1 step 1 until rowsz do
begin
pptr := inptr(rscan,1,pbuf); sptr := inptr(rscan,1,sbuf);
for cscan := 1 step 1 until colsz do
begin
datap := ildb(pptr); datas := ildb(sptr);
if datas div 8 = forkconst then
begin
getbranch(branch);
if branch then
begin
datas := getpnt(nr,nc,sbuf); prer := rscan;
datap := getpnt(nr,nc,pbuf); prec := cscan;
ssgdisplay(nr,nc);
setps(rscan,cscan+1);
end;
end;
end;
end;
for rscan := 1 step 1 until rowsz do
begin
pptr := inptr(rscan,1,pbuf); sptr := inptr(rscan,1,sbuf);
mptr := INPTR(rscan,1,markbuf);
for cscan := 1 step 1 until colsz do
begin
datap := ildb(pptr); datas := ildb(sptr);
datam := ildb(mptr);
if endless and datam neq marked then
begin
ssgdisplay(rscan,cscan);
setps(rscan,cscan+1);
mptr := inptr(rscan,cscan+1,markbuf);
end;
end;
end;
legend(picture & ".ps");
endisplay;
frebuf(markbuf);
bprmpt(" Any more",yes);
end until not yes;
end; "display"
procedure getleaders(reference integer ct);
begin
integer tempr, tempc; integer dddd;
simple procedure brijmacro(integer bid,ang,lid);
begin
tempr := r[bid]; tempc := c[bid];
nextcoord((dddd+ang) mod 8,tempr,tempc);
ltr[lid] := tempr; ltc[lid] := tempc;
ltmag[lid] := getpnt(tempr,tempc,thrbuf);
if ltmag[lid] neq 0 then
begin
if getpnt(tempr,tempc,pbuf) = deadend then
begin
if not samedir(getpnt(tempr,tempc,dirbuf),dir,2) then
ltmag[lid] := 0 else ct := ct + 1;
end else ltmag[lid] := 0;
end;
end;
dddd := dirn(dir); ct := 0;
brijmacro(1,6,1);
brijmacro(1,7,2);
brijmacro(2,7,3);
brijmacro(2,0,4);
brijmacro(2,1,5);
brijmacro(3,1,6);
brijmacro(3,2,7);
end;
procedure pickbest(integer angle);
begin
! procedure picks the "best" of the 7 possible leaders for
bridging the one-element gap;
define dl = "datalevel";
integer temp;
simple procedure pickmacro(integer bid,lid,pl,pb,sb,st);
begin
putpnt(ltr[lid],ltc[lid],((angle+pl) mod 8) + dl,pbuf);
putpnt(r[bid],c[bid],((angle+pb) mod 8) + dl,pbuf);
putpnt(r[bid],c[bid],((angle+sb) mod 8) + dl,sbuf);
putpnt(rscan,cscan,((angle+st) mod 8) + dl,sbuf);
end;
if even(angle) then " 45 deg trailer "
begin
if dir mod 3 = 0 then
begin " more anticlockwise than angle suggests"
if ltmag[5] neq 0 then pickmacro(2,5,5,4,1,0) else
if ltmag[4] neq 0 then pickmacro(2,4,4,4,0,0) else
if ltmag[3] neq 0 then pickmacro(2,3,3,4,7,0) else
if ltmag[6] neq 0 then pickmacro(3,6,5,5,1,1) else
if ltmag[2] neq 0 then pickmacro(1,2,3,3,7,7) else
if ltmag[7] neq 0 then pickmacro(3,7,6,5,2,1) else
if ltmag[1] neq 0 then pickmacro(1,1,2,3,6,7);
end else
begin
if ltmag[3] neq 0 then pickmacro(2,3,3,4,7,0) else
if ltmag[4] neq 0 then pickmacro(2,4,4,4,0,0) else
if ltmag[5] neq 0 then pickmacro(2,5,5,4,1,0) else
if ltmag[2] neq 0 then pickmacro(1,2,3,3,7,7) else
if ltmag[6] neq 0 then pickmacro(3,6,5,5,1,1) else
if ltmag[1] neq 0 then pickmacro(1,1,2,3,6,7) else
if ltmag[7] neq 0 then pickmacro(3,7,6,5,2,1);
end;
end else
begin "vert or hor trailer"
if ltmag[4] neq 0 then pickmacro(2,4,4,4,0,0) else
if ltmag[3] neq 0 or ltmag[5] neq 0 then
begin
temp := getpnt(rscan,cscan,thrbuf);
if abs(temp-ltmag[3]) leq abs(temp-ltmag[5]) then
pickmacro(2,3,3,4,7,0) else pickmacro(2,5,5,4,1,0);
end else
if ltmag[2] neq 0 or ltmag[6] neq 0 then
begin
temp := getpnt(rscan,cscan,thrbuf);
if abs(temp-ltmag[2]) leq abs(temp-ltmag[6]) then
pickmacro(1,2,3,3,7,7) else pickmacro(3,6,5,5,1,1);
end else
if ltmag[1] neq 0 or ltmag[7] neq 0 then
begin
temp := getpnt(rscan,cscan,thrbuf);
if abs(temp-ltmag[1]) leq abs(temp-ltmag[7]) then
pickmacro(1,1,2,3,6,7) else pickmacro(3,7,6,5,2,1);
end;
end;
end;
simple boolean procedure halfgaps(integer angle);
begin
! connects neighbours even if directions are different;
integer cand; ! One of the 3 is the actual candidate;
integer i, no;
no := 0;
for i := 1 step 1 until 3 do
begin
if getpnt(r[i],c[i],thrbuf) neq 0 and
getpnt(r[i],c[i],pbuf) = deadend then
begin
cand := i; no := no + 1;
end;
end;
if no = 1 then
begin
putpnt(rscan,cscan,((angle+cand-2) mod 8)+datalevel,sbuf);
putpnt(r[cand],c[cand],((angle+cand+2) mod 8)+datalevel,pbuf);
hgcount := hgcount + 1;
return(true);
end else return(false);
end;
internal simple procedure psmaker;
begin
integer tptr, dptr, tt, dd;
integer cand; ! One of the 3 is the actual candidate;
integer i;
heading;
print(" It uses *.dir, *.thr files. ", crlf);
msec := trtime;
for rscan := 2 step 1 until rowsz-1 do
begin
tptr := inptr(rscan,2,thrbuf);
dptr := inptr(rscan,2,dirbuf);
for cscan := 2 step 1 until colsz-1 do
begin
tt := ildb(tptr);
if tt neq 0 then
beGIN
dir := ildb(dptr); dd := dirn(dir);
getneighbours(dd); prepareps(dd,sbuf);
oppdir := (dd+4) mod 8;
getneighbours(oppdir); prepareps(oppdir,pbuf);
eND eLSe
Ibp(DpTr);
end;
if rscan mod 50 = 0 then
print(" ",rscan," rows processed.",crlf);
end;
print(" Time for .p and .s making: ",trtime-msec," ms.",crlf);
end; " psmaker "
internal simple procedure bridgaps;
begin "bridgaps"
integer sptr, pptr; ! pointers to files;
integer dd; ! variable to hold data;
integer count; ! a counter;
if gapsbridged = marked then
begin
print(" Gaps already bridged.",crlf); return;
end else gapsbridged := marked;
msec := trtime;
noofbridges := 0; hgcount := 0;
for rscan := 3 step 1 until rowsz-2 do
begin
sptr := inptr(rscan,3,sbuf); pptr := inptr(rscan,3,pbuf);
for cscan := 3 step 1 until colsz-2 do
begin
datas := ildb(sptr); datap := ildb(pptr);
if datas = deadend and datap neq deadend then
begin
dir := getpnt(rscan,cscan,dirbuf); dd := dirn(dir);
getneighbours(dd);
if not halfgaps(dd) then
begin
getleaders(count);
if count geq 1 then
begin
pickbest(dd); noofbridges := noofbridges + 1;
end;
end;
end;
end;
end;
print(" No of gaps bridged: ",noofbridges);
print(" No of half gaps filled: ",hgcount,crlf);
print(" Time for bridging only: ",trtime-msec," ms.",crlf);
end "bridgaps" ;
internal procedure findcorners;
begin
integer temp;
real epsilon;
BOOLEAN DETAILED;
procedure ssgprocess(integer rrr, ccc);
begin
integer r1, r2, c1, c2, ltemp;
real cosalfa, tanalfa, p0, error, perror, erratyes;
integer array rloc,cloc[1:5*colsz];
integer startpt, endpt, linesz, found, globyes;
comment
To process a supersegment, all the points on it, i.e.,
their cordinates, are first taken into core (in the
array rloc, cloc[1:5*colsz]), since we
will have to use them over and over again in finding
corners .;
recursive procedure cornersinwindow(integer p1,p2;
REFErence integer yes);
begin
integer junk;
comment
Later corners are junked because we are interested in only
one corner -- the last.;
yes := 0; erratyes := epsilon;
if p2 leq p1+4 then return;
r1 := rloc[p1]; r2 := rloc[p2]; c1 := cloc[p1]; c2 := cloc[p2];
DETAILED := FALSE;
IFCR FNDCDEBUG THENC
BEGIN
PRINT(" CORNERSINWINDOW. ",CRLF);
PRINT(" ",R1,",",C1," TO ",R2,",",C2,CRLF);
BPRMPT(" DETAILED ANALYSIS " & '77,DETAILED);
END;
ENDC
if c1 = c2 then tanalfa := infinity
else tanalfa := -(r1-r2)/(c1-c2);
cosalfa := abs(c1-c2)/sqrt((r1-r2)↑2 + (c1-c2)↑2);
if cosalfa = 0 then p0 := c1*1.0
else p0 := (r1+c1*tanalfa) * cosalfa;
ltemp := p1 + 1; perror := 0;
do begin
error := abs((rloc[ltemp]+cloc[ltemp]*tanalfa)*cosalfa - p0);
IFCR FNDCDEBUG THENC
IF DETAILED THEN
PRINT(" STEP BY STEP: ",RLOC[ltemp],",",CLOC[ltemp]," : ",ERROR,CRLF);
ENDC
if error < perror and perror geq erratyes then
begin
yes :=ltemp - 1; erratyes := perror;
if yes > globyes then globyes := yes;
end;
ltemp :=ltemp + 1; perror := error;
end until ltemp > p2;
if yes neq 0 then
begin
IFCR FNDCDEBUG THENC
BEGIN
PRINT(" CORNERSINWINDOW ", CRLF);
PRINT(RLOC[P1]," ",CLOC[P1]," ",RLOC[YES]," ",CLOC[YES],
" ",RLOC[P2]," ",CLOC[P2]," ",PERROR,CRLF);
S := INTTY;
END;
ENDC
ltemp := getpnt(rloc[yes],cloc[yes],sbuf) ;
if ltemp div 8 = dataconst then
putpnt(rloc[yes],cloc[yes],ltemp mod 8 + corner,sbuf);
ltemp := getpnt(rloc[yes],cloc[yes],pbuf) ;
if ltemp div 8 = dataconst then
putpnt(rloc[yes],cloc[yes],ltemp mod 8 + corner,pbuf);
cornersinwindow(p1,yes,junk);
cornersinwindow(yes,p2,junk);
end;
end; "cornersinwindow"
datap := getpnt(rrr,ccc,pbuf);
datas := getpnt(rrr,ccc,sbuf);
linesz := 0;
while not ssgstop(rrr,ccc) do
begin
IFCR RANGEDEBUG THENC
BEGIN
IF LINESZ > 5*COLSZ THEN
PRINT(RSCAN," ",CSCAN," ",RRR," ",CCC," RANGECHECK",CRLF);
END;
ENDC
prer := rrr; prec := ccc; linesz := linesz + 1;
rloc[linesz] := rrr; cloc[linesz] := ccc;
putpnt(rrr,ccc,marked,markbuf);
nextcoord(datas mod 8,rrr,ccc);
datap := getpnt(rrr,ccc,pbuf);
datas := getpnt(rrr,ccc,sbuf);
end;
linesz := linesz + 1;
rloc[linesz] := rrr; cloc[linesz] := CCC;
if datap div 8 neq forkconst and not npred(rrr,ccc) then
putpnt(rrr,ccc,marked,markbuf);
if linesz > 3*rowsz then
begin
print(" Long one! ",linesz," links for this supersegment.",
crlf);
print(" beginning -- rscan: ",rscan, crlf);
print(" beginning -- cscan: ",cscan, crlf);
end;
startpt := 1; globyes := 0;
do begin
endpt := startpt - 1+ wsz;
if endpt > linesz then endpt := linesz;
cornersinwindow(startpt,endpt,found);
if found = 0 and linesz > endpt then
do begin
endpt := endpt + Wsz;
if endpt > linesz then endpt := linesz;
cornersinwindow(startpt,endpt,found);
end until endpt = linesz or found neq 0;
if found = 0 then startpt := linesz
else startpt := globyes;
end until startpt geq linesz;
end; "ssgprocess"
msec := trtime;
print(" Corner finding in " & picture, crlf);
wsz := 32; iprmpt(" Window size (in pixel units) ",wsz);
iepsilon := 20;
iprmpt(" pixel error (actual value to be used is divided" &
"by 10)",iepsilon);
epsilon := iepsilon/10.0;
getbuf(rowsz,colsz,onebit,markbuf:=FNDBUF);
for rscan := 2 step 1 until rowsz - 1 do
begin
pptr := inptr(rscan,2,pbuf); sptr := inptr(rscan,2,sbuf);
for cscan := 2 step 1 until colsz - 1 do
begin
datap := ildb(pptr); datas := ildb(sptr);
IFCR SSDEBUG THENC
BEGIN
IF RDEBUG- 8 < RSCAN AND RSCAN < RDEBUG+ 8 AND
CDEBUG-8 < CSCAN AND CSCAN < CDEBUG+8 THEN
BEGIN
PRINT(" FINDCORNERS", CRLF);
PRINT(RSCAN," ",CSCAN," ",DATAP," ",DATAS," ",sgstart," ",SGSTOP,
CRLF); S := INTTY;
END;
END;
ENDC
if nopred and datas neq 0 then
begin
ssgprocess(rscan,cscan);
setps(rscan,cscan+1);
end;
end;
if rscan mod 50 = 0 then
print(" ",rscan," rows processed.",crlf);
end;
for rscan := 2 step 1 until rowsz - 1 do
begin
pptr := inptr(rscan,2,pbuf); sptr := inptr(rscan,2,sbuf);
for cscan := 2 step 1 until colsz - 1 do
begin
datap := ildb(pptr); datas := ildb(sptr);
if datas div 8 = forkconst then
begin
getbranch(branch);
if branch then
begin
prer := rscan; prec := cscan;
datas := getpnt(nr,nc,sbuf);
datap := getpnt(nr,nc,pbuf);
ssgprocess(nr,nc);
setps(rscan,cscan+1);
end;
end;
end;
end;
print(" Second Pass over in finding corners. ",crlf);
for rscan := 2 step 1 until rowsz - 1 do
begin
pptr := inptr(rscan,2,pbuf); sptr := inptr(rscan,2,sbuf);
mptr := inptr(rscan,2,markbuf);
for cscan := 2 step 1 until colsz - 1 do
begin
datap := ildb(pptr); datas := ildb(sptr);
datam := ILDB(MPTR);
if endless and datam neq marked then
begin
ssgprocess(rscan,cscan);
setps(rscan,cscan+1);
mptr := inptr(rscan,cscan+1,markbuf);
end;
end;
end;
print(" Corner finding complete. ",crlf);
foundcorners := corner; puthdr(header,pbuf);
FREBUF(markbuf);
print(" Time for corner finding: ",trtime-msec,crlf);
end; "findcorners"
IFCR NOT SMALL THENC
procedure ssegrecmaker(integer sr, sc);
begin
comment
Prepares a record as declared in <babu>seg.data of a super-
segment and outputs by calling a routine declared in
<babu>seg.sai. To make the program structured, I have made a
separate procedure for making segments. The variables
integer segno, ssegno
keep track of the number of segments and supersegments made up
so far.;
real l; ! length of a segment;
procedure segrecmaker;
begin
integer rr, cc;
integer p,suc,fk;
real t; ! angle of a segment;
if datap neq deadend then p := segno else p := 0;
segno := segno + 1; rr := sr; cc := sc;
IFC SDEBUG THENC
PRINT(" STARTING SEGNO ",SEGNO,CRLF);
PRINT(" STARTING POINT ",SR," ",SC);
ENDC
do begin
putpnt(sr,sc,marked,markbuf); prer := sr; prec := sc;
nextcoord(datas mod 8,sr,sc);
datas := getpnt(sr,sc,sbuf); datap := getpnt(sr,sc,pbuf);
end until sgstop(sr,sc);
l := sqrt((rr-sr)↑2 + (cc-sc)↑2);
t := myatan(sc-cc,sr-rr);
if datas neq deadend then SUC := segno + 1
ELSE suc := 0;
IFCR SGDSPDEBUG THENC sgDSPLAY ENDC
sgdep(segno,ssegno,p,suc,fk,rr,cc,sr,sc,l,t);
end; "segrecmaker"
ssegno := ssegno + 1;
IFC SDEBUG THENC
PRINT(" STARTING SSEGNO ",SSEGNO,CRLF);
PRINT(" RSCAN: ",RSCAN," CSCAN: ",CSCAN,CRLF);
ENDC
zr1 := sr; zc1 := sc; zf := segno + 1; zml := 0.0;
while not(ssgstop(sr,sc)) do
begin
segrecmaker;
if l > zml then zml := l;
end;
ssgdep(ssegno,zf,segno-zf+1,zr1,zc1,sr,sc,zml);
end; "ssegrecmaker"
internal simple procedure pstoseg;
begin
comment
This is the procedure to be called from 'outside' if we want
to make the .seg file using .p and .s files. Care must be
exercised to use the correct initialisation routine.;
segno := 0; ssegno := 0;
IFCR SGDSPDEBUG THENC SGDSPINIT; ENDC
GETBUF(ROWSZ,COLSZ,ONEBIT,MARKBUF:=FNDBUF);
for rscan := 1 step 1 until rowsz do
begin
sptr := inptr(rscan,1,sbuf); pptr := inptr(rscan,1,pbuf);
for cscan := 1 step 1 until colsz do
begin
datas := ildb(sptr); datap := ildb(pptr);
if nopred and datas neq 0 then
begin
ssegrecmaker(rscan,cscan);
setps(rscan,cscan+1);
end;
end; "cscan"
if rscan mod 50 = 0 then
print(" ",rscan," rows done in segment making. pass 1.",crlf);
end;
for rscan := 1 step 1 until rowsz do
begin
sptr := inptr(rscan,1,sbuf); pptr := inptr(rscan,1,pbuf);
for cscan := 1 step 1 until colsz do
begin
datas := ildb(sptr); datap := ildb(pptr);
if datas div 8 = forkconst then
begin
getbranch(branch);
if branch then
begin
datas := getpnt(nr,nc,sbuf); prer := rscan;
datap := getpnt(nr,nc,pbuf); prec := cscan;
ssegrecmaker(nr,nc);
setps(rscan,cscan+1);
end;
end;
end; "cscan"
if rscan mod 50 = 0 then
print(" ",rscan," rows done in segment making. pass 2.",crlf);
end;
for rscan := 1 step 1 until rowsz do
begin
sptr := inptr(rscan,1,sbuf); pptr := inptr(rscan,1,pbuf);
mptr := inptr(rscan,1,markbuf);
for cscan := 1 step 1 until colsz do
begin
datas := ildb(sptr); datap := ildb(pptr);
datam := ildb(mptr);
if endless and datam neq marked then
begin
ssegrecmaker(rscan,cscan);
setps(rscan,cscan+1);
mptr := inptr(rscan,cscan+1,markbuf);
end;
end; "cscan"
if rscan mod 50 = 0 then
print(" ",rscan," rows done in segment making. pass 3.",crlf);
end;
print(" ",ssegno," supersegments found.",crlf);
print(" ",segno," segments found.",crlf);
IFCR SGDSPDEBUG THENC
BEGIN
SGDSPCLOSE;
PRINT(SSEGNO, " ",SSEG:NOOFSEG[PSSEG],CRLF);
END;
ENDC
depsg(segno,rowsz,colsz);
deparms(ssegno,rowsz,colsz);
FREBUF(MARKBUF);
end; "pstoseg"
ENDC "SMALL"
internal simple procedure globinit;
begin
bufinit; cdisplay := false;
end; "globinit"
internal simple procedure tdinit;
begin
indmp("",picture & ".thr",thrbuf:=FNDBUF,cmu);
indmp("",picture & ".dir",dirbuf:=FNDBUF,cmu);
rowsz := rows(thrbuf); colsz := colms(thrbuf);
print(" picture name is ",PICTURE, crlf);
print(" picture dimensions -- rowsz: ",rowsz,crlf);
print(" colsz: ",colsz,crlf);
end; "tdinit"
internal simple procedure tdfree;
begin
frebuf(thrbuf); frebuf(dirbuf);
end; "tdfree"
internal simple procedure psopen;
begin
getbuf(rowsz,colsz,fivebits,pbuf:=fndbuf);
getbuf(rowsz,colsz,fivebits,sbuf:=fndbuf);
gethdr(header,pbuf);
end; "psopen"
internal simple procedure psinit;
begin
pagesincore := 10;
iprmpt(" No of pages in core",pagesincore);
pagset(pagesincore);
indmp("",picture & ".p",pbuf:=FNDBUF,cmu);
indmp("",picture & ".s",sbuf:=FNDBUF,cmu);
pagset(10);
rowsz := rows(pbuf); colsz := colms(pbuf);
print(" picture name is ",PICTURE, crlf);
print(" picture dimensions -- rowsz: ",rowsz,crlf);
print(" colsz: ",colsz,crlf);
gethdr(header,pbuf);
if foundcorners = corner then
print(" Corners are already marked. ",crlf) else
print(" Corners have not been marked. ",crlf);
end; "psinit"
internal simple procedure psdump;
begin
print(" No of pages in core: ",pagesincore,crlf);
print(" No of page faults: ",pagflt[pbuf],crlf);
puthdr(header,pbuf);
outdmp("",picture & ".p",pbuf,cmu);
outdmp("",picture & ".s",sbuf,cmu);
end; "psdump"
internal simple procedure psfree;
begin
frebuf(sbuf); frebuf(pbuf);
end; "psfree"
internal simple procedure cleancorners;
begin
msec := trtime;
for rscan := 1 step 1 until rowsz do
begin
pptr := inptr(rscan,1,pbuf); sptr := inptr(rscan,1,sbuf);
for cscan := 1 step 1 until colsz do
begin
datap := ildb(pptr); datas := ildb(sptr);
if datap >= corner then datap := (datap mod corner) + datalevel;
if datas >= corner then datas := (datas mod corner) + datalevel;
dpb(pptr,datap); dpb(sptr,datas);
end;
end;
foundcorners := 0;
print(" Time for corner cleaning: ",trtime-msec," ms.",crlf);
end "cleancorners" ;
internal simple procedure checkheader;
begin
iprmpt(" row size",rowsz);
iprmpt(" col size",colsz);
iprmpt(" corners made -- [1: yes, 0: no]",foundcorners);
iprmpt(" gaps bridged -- [1:yes, 0:no]",gapsbridged);
iprmpt(" No of gaps bridged",noofbridges);
iprmpt(" No of half-gaps bridged",hgcount);
iprmpt(" Window size for corner making",wsz);
iprmpt(" Pixel error for corner making",iepsilon);
puthdr(header,pbuf);
end;
end "ps"